Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/TCPExample/PNL Libraries/MyTransport.p

Text File | 1997-06-18 | 78KB | 2,925 lines

unit MyTransport;

interface

    uses
        Types, OpenTransport, TCPTypes, TCPUtils;

    var
        have_OT:Boolean;

    const
        couldNotGetRequestedPortErr = -900099;

    const
        kMyStreamClosingErr = connectionClosingErr;

    type
        TransportDeferredTaskCookie = longint;
        TransportDeferredTaskProcPtr = ProcPtr; { procedure(arg:Ptr) }
        TransportRef = ^integer;
        TransportUDPRef = ^Point;

    type
        IPAddrArray = array[1..1000] of ipAddr;
        IPAddrArrayPtr = ^IPAddrArray;

    type
        TransportPingResults = record
                remotehost: ipAddr;
                data: Ptr;
                datasize: longint;
                timetaken: longint; { time taken in microseconds }
            end;

    type
        MemoryReleasedProc = procedure (tref: TransportRef; result: OTResult; cookie: univ Ptr);
        TransitionNotifierProc = procedure ( up: boolean );
            { link comes up, OT/MT is initialized, you are called ith true,
                link goes down or program finishes, you are called with false, OT/MT is released }

    var
        hack_MemoryReleasedProc: MemoryReleasedProc;
        transport_system_is_alive: Boolean;
{ * means Interupt-safe }

    procedure TransportInstallTransitionNotifier( notifier: TransitionNotifierProc ); { Can call this before Startup() }

    procedure StartupTransport;
    procedure ConfigureTransport(allow_OT: Boolean);

    function OpenTransportSystem:OSStatus;
    procedure CloseTransportSystem;

    function TransportListen(var token:Ptr; localport:ipPort; listeners:integer; buffer_size:longint):OSStatus;
    function TransportGetListenerConnection(token:Ptr; var tref:TransportRef):OSStatus;
    procedure TransportDestroyListener(var token:Ptr);

    function TransportOpenActiveConnection(var tref:TransportRef; dest:Str255; localport:ipPort; buffer_size:longint): OSStatus;
    function TransportOpenPassiveConnection(var tref:TransportRef; var localport:ipPort; buffer_size:longint): OSStatus;
    procedure TransportGetOpenResult(tref:TransportRef; var result: OSStatus); { * }

    procedure TransportDestroy(var tref:TransportRef);

    function TransportGetConnectionState (tref:TransportRef): TCPStateType;
    function TransportGetConnectionStateInteruptSafe (tref:TransportRef): TCPStateType; { * }
        { Note: May not change until idle time }
    function TransportGetPorts(tref:TransportRef; var localip: ipAddr; var localport: ipPort; var remoteip: ipAddr; var remoteport: ipPort): OSStatus;
    procedure TransportSendClose(tref:TransportRef);

    function TransportHandleTransfers(tref:TransportRef): OSStatus;

    function TransportHandleReceives(tref:TransportRef): OSStatus;
    function TransportReceive(tref:TransportRef; buf: Ptr; len:longint; var count:longint): OSStatus;
    function TransportCharsAvailable(tref:TransportRef): longint;
    function TransferPeekCharsAvailable(tref:TransportRef; const look: Str255): longint;

    function TransportHandleSends(tref:TransportRef): OSStatus;
    function TransportSend(tref:TransportRef; buf: Ptr; len:longint): OSStatus;
    function TransportSendQueued(tref:TransportRef): longint;

    procedure TransportLowGetStreamPtr(tref:TransportRef; var stream: StreamPtr);
    procedure TransportLowGetEndpointRef(tref:TransportRef; var ep: EndpointRef);
    function TransportLowSetOTAckSends(tref:TransportRef; handler: MemoryReleasedProc): OSStatus;

    function TransportGetMyIPAddr(var ip:ipAddr): OSStatus;

    function TransportCreateDeferredTask(proc: OTProcessProcPtr; arg: UNIV Ptr): TransportDeferredTaskCookie;
    procedure ScheduleDeferredTask(cookie:TransportDeferredTaskCookie); { * }
    procedure DestroyDeferredTaskCookie(cookie:TransportDeferredTaskCookie);

    procedure TransportEnterInterrupt;
    procedure TransportLeaveInterrupt;

    function TransportUDPOpenPort(var tref: TransportUDPRef; var localport: ipPort; buffer_size:longint): OSStatus;
    procedure TransportUDPDestroy (var tref: TransportUDPRef);
    function TransportUDPDatagramsAvailable (tref: TransportUDPRef): longint;
    function TransportUDPRead (tref: TransportUDPRef; var remoteip: longint; var remoteport: ipPort;
                                    var datap: Ptr; var datalen: integer): OSStatus;
    function TransportUDPReturnBuffer (tref: TransportUDPRef; datap: Ptr): OSStatus;
    function TransportUDPWrite (tref: TransportUDPRef; remoteip: longint; remoteport: ipPort;
                                    datap: Ptr; datalen: integer; checksum: boolean): OSStatus;

    function TransportIPSendPing (remotehost: ipAddr; timeout: integer; datap: Ptr; datalen: integer; var token: Ptr): OSStatus;
    procedure TransportGetIPSendPingResult( var token: Ptr; var result: OSStatus; var results: TransportPingResults );
    procedure TransportDisposeIPSendPingResult( var results: TransportPingResults ); { call if TransportGetIPSendPingResult result = noErr to dispose data }
    procedure TransportAbortIPSendPing( var token: Ptr );

    function TransportNameToAddr(name: Str255; var token: Ptr): OSStatus;
    procedure TransportGetNameToAddrResult(var token: Ptr; var result: OSStatus; name:StringPtr; addrs:IPAddrArrayPtr; len:integer); { * }

    function TransportAddrToName(addr: ipAddr; var token: Ptr): OSStatus;
    procedure TransportGetAddrToNameResult(var token: Ptr; var result: OSStatus; var name:Str255); { * }

    procedure TransportAbortDNR(var token: Ptr);

    procedure IdleTransport;

implementation

    uses
        Events, TextUtils, Processes, OSUtils,Memory, Timer, Errors, Memory,
        OpenTptInternet, GestaltEqu, Devices, CodeFragments, MixedMode, MyLowLevel,
        MyCStrings, MyAssertions, DNR, MyStrings, MyMathUtils, MyGrowZones, MyTypes,
        MyUtils, MyMemory, MyCallProc, PreserveA5, MyStartup, MyLookFreeOT;

    const
        use_OT_tasks = false;

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

    type
        TransitionInfo = record
                proc: TransitionNotifierProc;
                system: Boolean;
            end;
    const
        max_transition_notifiers = 20;
    var
        transition_notifier_count: longint; { relies on Pascal to init this to zero at startup }
        transitions: array[1..max_transition_notifiers] of TransitionInfo;

    type
        TransportUDPRecord = record
            case boolean of
            false:(
                stream: StreamPtr;
                stream_buffer: Ptr;
                outstanding_packets: longint;
            )
            true:(
                ep: EndpointRef;
                packets_available: boolean;
            )
        end;
        TransportUDPRecordPtr = ^TransportUDPRecord;

    type
        TransportRecordPtr = ^TransportRecord;
        TransportRecord = record
            next: TransportRecordPtr;
            input_handle: Handle;
            max_input_handle_size: longint;
            output_handle: Handle;
            sending_handle: Handle;
            send_error, receive_error: OSStatus;
            open_result: OSStatus;
            started_opening: Boolean;
            handle_receives, handle_sends: Boolean;
            do_send_close: Boolean;
            case boolean of
            false:(
                remote_port:ipPort;
                local_port:ipPort;
                stream:StreamPtr;
                stream_buffer:Ptr;
                open_cb, close_cb, send_cb:TCPControlBlock;
                send_wds: wdsType;
                dnr_token:Ptr;
                tstate:TCPStateType;
            )
            true:(
                ep: EndpointRef;
                rcvCall, sndCall: TCall;
                rcvsin: InetAddress;
                sndsin: DNSAddress;
                waiting_for_connect: Boolean;
                connect_received: Boolean;
                accept_received: Boolean;
                passcon_received: Boolean;
                wake_process:ProcessSerialNumber;
                disconnect_received: Boolean;
                connect_result:OSStatus;
                accept_result:OSStatus;
                passcon_result:OSStatus;
                MemoryReleasedHandler: MemoryReleasedProc;
            )
        end;

    type
        MyDeferredTask = record
            dt:DeferredTask;
            fired:Boolean;
            completion:UniversalProcPtr;
            real_arg:longint;
        end;
        MyDeferredTaskPtr = ^MyDeferredTask;

    type
        XInetHostInfo = record
            host:InetHostInfo;
            result:OSStatus;
        end;
        XInetHostInfoPtr = ^XInetHostInfo;
        TDNRRecordPtr = ^TDNRRecord;
        TDNRRecord = record
            next:TDNRRecordPtr;
            kind: (TK_NameToAddr, TK_AddrToName);
            dead: Boolean;
            case boolean of
                true:(
                    dr:DNRRecord;
                    canonical_name: Str255;
                );
                false:(
                    xhost:XInetHostInfo; { Warning InetHostInfo must *start* with an InetDomainName! }
                );
        end;

    const
{        kReopenInternetServices = -91234598;}
        idle_space_size = 32768;
        max_reopen_frequency = 10 * second_in_ticks;
        kOTVersion111 = $01118000;
        kOTTILISTENVersion = kOTVersion111;
    var
        transports:QHdr;
        gMyDeferredTaskHandlerProc : UniversalProcPtr;
        is_ref:InetSvcRef;
        is_result: OTResult;
        dnrs:QHdr;
        idle_space: Ptr;
        tcp_open_status: OSStatus;
        last_reopen_time: longint;
        calling_notifiers: Boolean;
        ot_version: longint;

    procedure OTAbortAllDNRs; forward;

    procedure CallTransitionNotifiers( up: Boolean );
        var
            i: integer;
            proc: TransitionNotifierProc;
            saved_calling_notifiers: Boolean;
    begin
        saved_calling_notifiers := calling_notifiers;
        calling_notifiers := true;
        for i := 1 to transition_notifier_count do begin
            if transitions[i].system = up then begin
                proc := transitions[i].proc;
                proc(up);
            end;
        end;
        for i := 1 to transition_notifier_count do begin
            if transitions[i].system <> up then begin
                proc := transitions[i].proc;
                proc(up);
            end;
        end;
        calling_notifiers := saved_calling_notifiers;
    end;

    procedure InstallTransitionNotifier( notifier: TransitionNotifierProc; system: Boolean );
    begin
        Assert( transition_notifier_count < max_transition_notifiers );
        Inc(transition_notifier_count);
        transitions[transition_notifier_count].proc := notifier;
        transitions[transition_notifier_count].system := system;
    end;

    procedure TransportInstallTransitionNotifier( notifier: TransitionNotifierProc );
    begin
        InstallTransitionNotifier( notifier, false );
    end;

    function TransportSystemIsAlive: OSStatus;
        var
            err: OSStatus;
            cb: IPControlBlock;
            info:InetInterfaceInfo;
    begin
        err := tcp_open_status;
        if err = noErr then begin
            if have_OT then begin
                err := OTInetGetInterfaceInfo(info, 0);
            end else begin
                MZero(@cb, SizeOf(cb));
                cb.ioCRefNum := mactcp_driver_refnum;
                cb.csCode := TCPcsGetMyIP;
                err := PBControlSync(@cb);
            end;
        end;
        TransportSystemIsAlive := err;
    end;

    procedure MCloseProvider( var ref: ProviderRef );
        var
            junk: OSErr;
    begin
        Assert( ref <> nil );
        junk := OTCloseProvider( ref );
        ref := nil;
        Assert( junk = noErr );
    end;

    procedure InternetServicesHandler(context:Ptr; event: OTEventCode; result: OTResult; cookie: XInetHostInfoPtr);
    begin
{$unused(context)}
        case event of
            T_OPENCOMPLETE: begin
                is_result := result;
                if result = noErr then begin
                    is_ref := InetSvcRef(cookie);
                end;
            end;
            T_DNRSTRINGTOADDRCOMPLETE, T_DNRADDRTONAMECOMPLETE: begin
                cookie^.result := result;
            end;
            kOTProviderIsClosed, kOTProviderWillClose: begin
                if is_ref <> nil then begin
                    MCloseProvider( is_ref );
                    is_result := -900014;
                end;
                OTAbortAllDNRs;
            end;
            otherwise
                ;
        end;
    end;

    procedure InternetServicesNotifier( up: Boolean );
        var
            err: OSErr;
            tmp: EndpointRef;
    begin
        if up then begin
            is_ref := nil;
            is_result := inProgress;
            err := OTAsyncOpenInternetServices(OTConfigurationPtr(kDefaultInternetServicesPath), 0, @InternetServicesHandler,nil);
            { WARNING: OTAsyncOpenInternetServices may have already completed }
            if err <> noErr then begin
                is_result := err;
            end;
        end else begin
            OTAbortAllDNRs;
            if (is_ref <> nil) then begin
                tmp := is_ref;
                is_ref := nil;
                MCloseProvider( tmp );
            end;
            if (is_result = noErr) or (is_result = inProgress) then begin
                is_result := -900015;
            end;
        end;
    end;

    function WaitForInternetServices: OSStatus;
    begin
        while is_result = inProgress do begin
            OTIdle;
        end;
        WaitForInternetServices := is_result;
    end;

    function ValidDNR(token: Ptr): Boolean;
        var
            this:TDNRRecordPtr;
    begin
        ValidDNR := false;
        this := TDNRRecordPtr(dnrs.qHead);
        while this <> nil do begin
            if Ptr(this) = token then begin
                ValidDNR := true;
                leave;
            end;
            this := this^.next;
        end;
    end;

    function TransportNameToAddr(name: Str255; var token: Ptr): OSStatus;
        var
            err: OSStatus;
            tdrp:TDNRRecordPtr;
    begin
        tdrp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tdrp, SizeOf(TDNRRecord));
        end;
        if err = noErr then begin
            tdrp^.kind := TK_NameToAddr;
            tdrp^.dead := false;
            if have_OT then begin
                tdrp^.xhost.result := inProgress;
                P2C(@name);
                err := WaitForInternetServices;
                if err = noErr then begin
                    err := OTInetStringToAddress(is_ref, @name, tdrp^.xhost.host);
                end;
            end else begin
                tdrp^.canonical_name := name;
                DNRNameToAddr(name, @tdrp^.dr, nil);
                err := noErr;
            end;
        end;
        if err = noErr then begin
            Enqueue(QElemPtr(tdrp),@dnrs);
        end else begin
            MDisposePtr(tdrp);
        end;
        token := Ptr(tdrp);
        TransportNameToAddr := err;
    end;

    procedure TransportGetNameToAddrResult(var token: Ptr; var result: OSStatus; name:StringPtr; addrs:IPAddrArrayPtr; len:integer);
        var
            tdrp:TDNRRecordPtr;
            i:integer;
            junk: OSStatus;
    begin
        tdrp := TDNRRecordPtr(token);
        result := -900001;
        if (tdrp <> nil) then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                if have_OT then begin
                    result := tdrp^.xhost.result;
                    if result = noErr then begin
                        if name <> nil then begin
                            CopyC2P(@tdrp^.xhost.host.name, name^);
                        end;
                        for i := 1 to len do begin
                            addrs^[i] := 0;
                        end;
                        for i := 1 to Min(kMaxHostAddrs, len) do begin
                            addrs^[i] := tdrp^.xhost.host.addrs[i-1];
                        end;
                    end;
                end else begin
                    result := tdrp^.dr.ioResult;
                    if result = noErr then begin
                        if name <> nil then begin
                            name^ := tdrp^.canonical_name;
                        end;
                        for i := 1 to len do begin
                            addrs^[i] := 0;
                        end;
                        for i := 1 to Min(len, 4) do begin
                            addrs^[i] := tdrp^.dr.hi.addrs[i];
                        end;
                    end;
                end;
                if result <> inProgress then begin
                    junk := Dequeue(QElemPtr(tdrp),@dnrs);
                    Assert( junk = noErr );
                    MDisposePtr(tdrp);
                    token := nil;
                end;
            end;
        end;
    end;

    function TransportAddrToName(addr: ipAddr; var token: Ptr): OSStatus;
        var
            err: OSStatus;
            tdrp:TDNRRecordPtr;
    begin
        tdrp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tdrp, SizeOf(TDNRRecord));
        end;
        if err = noErr then begin
            tdrp^.kind := TK_AddrToName;
            tdrp^.dead := false;
            if have_OT then begin
                tdrp^.xhost.result := inProgress;
                err := WaitForInternetServices;
                if err = noErr then begin
                    err := OTInetAddressToName(is_ref, addr, tdrp^.xhost.host.name);
                end;
            end else begin
                DNRAddrToName(addr, @tdrp^.dr, nil);
                err := noErr;
            end;
        end;
        if err = noErr then begin
            Enqueue(QElemPtr(tdrp),@dnrs);
        end else begin
            MDisposePtr(tdrp);
        end;
        token := Ptr(tdrp);
        TransportAddrToName := err;
    end;

    procedure TransportGetAddrToNameResult(var token: Ptr; var result: OSStatus; var name:Str255);
        var
            tdrp:TDNRRecordPtr;
            junk: OSStatus;
    begin
        tdrp := TDNRRecordPtr(token);
        result := -900002;
        if tdrp <> nil then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                if have_OT then begin
                    result := tdrp^.xhost.result;
                    if result = noErr then begin
                        CopyC2P(@tdrp^.xhost.host.name, name);
                    end;
                end else begin
                    result := tdrp^.dr.ioResult;
                    if result = noErr then begin
                        name := tdrp^.dr.name;
                    end;
                end;
                if result <> inProgress then begin
                    junk := Dequeue(QElemPtr(tdrp),@dnrs);
                    Assert( junk = noErr );
                    MDisposePtr(tdrp);
                    token := nil;
                end;
            end;
        end;
        if (result = noErr) & (name[length(name)] = '.') then begin
            Delete(name, length(name), 1);
        end;
    end;

    procedure TransportAbortDNR(var token: Ptr);
        var
            tdrp:TDNRRecordPtr;
    begin
        if token <> nil then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                tdrp := TDNRRecordPtr(token);
                tdrp^.dead := true;
            end;
        end;
    end;

    procedure IdleDNR(this:TDNRRecordPtr);
        var
            result: OSStatus;
            name:Str255;
    begin
        case this^.kind of
            TK_NameToAddr: begin
                TransportGetNameToAddrResult(Ptr(this), result, nil, nil, 0);
            end;
            TK_AddrToName: begin
                TransportGetAddrToNameResult(Ptr(this), result, name);
            end;
        end;
    end;

    procedure OTAbortAllDNRs;
        var
            this, next:TDNRRecordPtr;
    begin
        if have_OT then begin
            this := TDNRRecordPtr(dnrs.qHead);
            while this <> nil do begin
                next := this^.next;
                if this^.xhost.result = inProgress then begin
                    this^.xhost.result := kOTCanceledErr;
                end;
                this := next;
            end;
        end;
    end;

    procedure IdleDNRs;
        var
            this, next:TDNRRecordPtr;
    begin
        this := TDNRRecordPtr(dnrs.qHead);
        while this <> nil do begin
            next := this^.next;
            if this^.dead then begin
                IdleDNR(this);
            end;
            this := next;
        end;
    end;

    procedure WaitForDNRCompletions;
        var
            this:TDNRRecordPtr;
    begin
        if not have_OT then begin
            while dnrs.qHead <> nil do begin
                this := TDNRRecordPtr(dnrs.qHead);
                IdleDNR(this);
            end;
        end;
    end;

    procedure DNRNotifier( up: Boolean );
    begin
        if not up then begin
            if have_OT then begin
                OTAbortAllDNRs;
            end;
            WaitForDNRCompletions;
        end;
    end;

{ Deferred Tasks }

    procedure MyDeferredTaskHandlerPascal(dtp: MyDeferredTaskPtr);
        var
            olda5:Ptr;
    begin
        olda5 := SetPreservedA5;
        dtp^.fired := true;
        CallPascal04(dtp^.real_arg, dtp^.completion);
        RestoreA5(olda5);
    end;

{$IFC GENERATINGPOWERPC}
    procedure MyDeferredTaskHandler(dtp: MyDeferredTaskPtr);
    begin
        MyDeferredTaskHandlerPascal(dtp);
    end;
{$ELSEC}
    procedure MyDeferredTaskHandler;
        var
            param:MyDeferredTaskPtr;
    begin
        param := MyDeferredTaskPtr(GetRegA1);
        MyDeferredTaskHandlerPascal(param);
    end;
{$ENDC}

    function TransportCreateDeferredTask(proc: OTProcessProcPtr; arg: UNIV Ptr): TransportDeferredTaskCookie;
        var
            dtp:MyDeferredTaskPtr;
            result:longint;
    begin
        result := 0;
        if have_OT & use_OT_tasks then begin
            if OpenTransportSystem = noErr then begin
                result := OTCreateDeferredTask(proc, arg);
            end;
        end else begin
            dtp := MyDeferredTaskPtr(NewPtr(SizeOf(MyDeferredTask)));
            if dtp <> nil then begin
                dtp^.dt.dtAddr := gMyDeferredTaskHandlerProc;
                dtp^.dt.dtParam := longint(dtp);
                dtp^.dt.dtReserved := 0;
                dtp^.dt.dtFlags := 0;
                dtp^.dt.qType := ord(dtQType);
                dtp^.completion := NewProc(proc, uppPascal04ProcInfo);
                dtp^.real_arg := longint(arg);
                dtp^.fired := true;
                result := TransportDeferredTaskCookie(dtp);
            end;
        end;
        TransportCreateDeferredTask := result;
    end;

    procedure ScheduleDeferredTask(cookie:TransportDeferredTaskCookie);
        var
            dummy:Boolean;
            dtp:MyDeferredTaskPtr;
    begin
        if have_OT & use_OT_tasks then begin
            if  TransportSystemIsAlive = noErr then begin
                dummy := OTScheduleDeferredTask(cookie);
            end;
        end else begin
            dtp := MyDeferredTaskPtr(cookie);
            if dtp^.fired then begin
                if DTInstall(DeferredTaskPtr(dtp)) = noErr then begin
                    dtp^.fired := false;
                end;
            end;
        end;
    end;

    procedure DestroyDeferredTaskCookie(cookie:TransportDeferredTaskCookie);
        var
            junk:OSStatus;
            dtp:MyDeferredTaskPtr;
    begin
        if have_OT & use_OT_tasks then begin
            if  TransportSystemIsAlive = noErr then begin
                junk := OTDestroyDeferredTask(cookie);
                Assert( junk = noErr );
            end;
        end else begin
            dtp := MyDeferredTaskPtr(cookie);
            while not dtp^.fired do begin
                { wait til it fires since we can't abort it }
            end;
            DisposeRoutineDescriptor(dtp^.completion);
            DisposePtr(Ptr(cookie));
        end;
    end;

    procedure TransportEnterInterrupt;
    begin
        if have_OT then begin
            OTEnterInterrupt;
        end;
    end;

    procedure TransportLeaveInterrupt;
    begin
        if have_OT then begin
            OTLeaveInterrupt;
        end;
    end;
{
    function ReopenInternetServicesOT: OSStatus;
        var
            err: OSStatus;
    begin
        if (is_ref = nil) & (is_result = kReopenInternetServices) then begin
            is_result := inProgress;
            err := OTAsyncOpenInternetServices(OTConfigurationPtr(kDefaultInternetServicesPath), 0, @InternetServicesHandler,nil);
            if err <> noErr then begin
                is_result := err;
            end;
        end;
        if is_result = inProgress then begin
            err := noErr;
        end else begin
            err := is_result;
        end;
        ReopenInternetServicesOT := err;
    end;
}
    function OpenTransportSystemOT:OSStatus;
        var
            err: OSStatus;
            ep:EndpointRef;
    begin
        err := InitOpenTransport;
        if err = noErr then begin
            is_result := -900023;
            is_ref := nil;
            ep := OTOpenEndpoint( OTCreateConfiguration( "udp" ), 0, nil, err );
            if err = noErr then begin
                MCloseProvider(ep);
            end;
            if err <> noErr then begin
                is_result := err;
                CloseOpenTransport;
            end;
        end;
        OpenTransportSystemOT := err;
    end;

    procedure CloseTransportSystemOT;
    begin
        CloseOpenTransport;
    end;

    function TransportGetConnectionStateOT(ep: EndpointRef):TCPStateType;
        var
            result: OTResult;
            state:TCPStateType;
    begin
        result := OTGetEndpointState(ep);
        state := T_Dead;
        if result >= 0 then begin
            case result of
                T_UNINIT, T_UNBND:
                    state := T_Dead;
                T_IDLE:begin
                    state := T_Bored;
                end;
                T_INCON, T_OUTCON:
                    state := T_Opening;
                T_DATAXFER:
                    state := T_Established;
                T_OUTREL:
                    state := T_Closing;
                T_INREL:
                    state := T_PleaseClose;
                otherwise begin
                    state := T_Unknown;
                end;
            end;
        end;
        TransportGetConnectionStateOT := state;
    end;

{ MacTCP routines }

    function OpenTransportSystemMT:OSStatus;
        var
            err:OSStatus;
    begin
        err := OpenDriver('.IPP', mactcp_driver_refnum);
        if err = noErr then begin
            err := OpenResolver;
        end;
        OpenTransportSystemMT :=     err;
    end;

    procedure CloseTransportSystemMT;
    begin
        CloseResolver;
    end;

{ Generic routines }

    function OpenTransportSystem:OSStatus;
    begin
        AssertDidStartup( startup_check );
        if not calling_notifiers then begin
            if (tcp_open_status = noErr) & (TransportSystemIsAlive <> noErr) then begin
                CloseTransportSystem;
            end;
            if (tcp_open_status <> noErr) & (TickCount >= last_reopen_time + max_reopen_frequency) then begin
                if have_OT then begin
                    tcp_open_status := OpenTransportSystemOT;
                end else begin
                    tcp_open_status := OpenTransportSystemMT;
                end;
                if tcp_open_status = noErr then begin
                    transport_system_is_alive := true;
                    CallTransitionNotifiers( true );
                end;
                last_reopen_time := TickCount;
            end;
        end;
        OpenTransportSystem := tcp_open_status;
    end;

    procedure CloseTransportSystem;
    begin
        if (tcp_open_status = noErr) then begin
            transport_system_is_alive := false;
            CallTransitionNotifiers( false );
            if have_OT then begin
                CloseTransportSystemOT;
            end else begin
                CloseTransportSystemMT;
            end;
            transport_system_is_alive := false;
            tcp_open_status := userCanceledErr;
        end;
    end;

    function TransportGetMyIPAddr(var ip:ipAddr): OSStatus;
        var
            err: OSStatus;
            cb: IPControlBlock;
            info:InetInterfaceInfo;
    begin
        err := OpenTransportSystem;
        if err = noErr then begin
            if have_OT then begin
                err := OTInetGetInterfaceInfo(info, 0);
                ip := info.fAddress
            end else begin
                MZero(@cb, SizeOf(cb));
                cb.ioCRefNum := mactcp_driver_refnum;
                cb.csCode := TCPcsGetMyIP;
                err := PBControlSync(@cb);
                ip := cb.getmyip.ourAddress;
            end;
        end;
        TransportGetMyIPAddr := err;
    end;

{ Open }

    function CreateOTEndpoint(var ep:EndpointRef; config: OTConfigurationPtr; proc:OTNotifyProcPtr; context:univ Ptr):OSErr;
        var
            err: OSStatus;
    begin
        ep:=OTOpenEndpoint(config,0,nil,err);
        if err = noErr then begin
            if proc <> nil then begin
                err:=OTInstallNotifier(ep, proc, context);
            end;
            if err <> noErr then begin
                MCloseProvider(ep);
            end;
        end;
        CreateOTEndpoint := err;
    end;

    procedure OTInitNetbuf(var nb:TNetbuf; buf:Ptr; len:Size);
    begin
        nb.buf := buf;
        nb.len := len;
        nb.maxlen := len;
    end;

    function SetReuseAddr(ep:EndpointRef):OSErr;
        var
            optreq:TOptMgmt;
            optBuffer:record
                header:TOptionHeader;
                value:longint;
            end;
    begin
        optreq.flags := T_NEGOTIATE;
        OTInitNetbuf(optreq.opt, @optBuffer, kOTFourByteOptionSize);
        optBuffer.header.len := kOTFourByteOptionSize;
        optBuffer.header.level := INET_IP;
        optBuffer.header.optName := IP_REUSEADDR;
        optBuffer.header.status := 0;
        optBuffer.value := $01000000;
        SetReuseAddr := OTOptionManagement(ep, @optreq, @optreq);
    end;

    function BindOTListener(ep:EndpointRef; var localport:ipPort; listeners:integer):OSErr;
        var
            err:OSStatus;
            reqsin, retsin:InetAddress;
            req, ret:TBind;
    begin
        MZero(@req, sizeof(req));
        err := noErr;
        if localport <> 0 then begin
            err := SetReuseAddr(ep);
            OTInitInetAddress(reqsin, localport, 0);
            OTInitNetbuf(req.addr, @reqsin, sizeof(InetAddress));
        end else begin
            OTInitNetbuf(req.addr, nil, 0);
        end;
        req.qlen := listeners;

        MZero(@ret, sizeof(ret));
        OTInitNetbuf(ret.addr, @retsin, sizeof(InetAddress));

        if err = noErr then begin
            err := OTBind(ep, @req, @ret);
            if (err = noErr) & (localport <> 0) & (localport <> retsin.fPort) then begin
                err := couldNotGetRequestedPortErr;
            end;
            localport := retsin.fPort;
        end;

        if err = noErr then begin
            err:=OTSetAsynchronous(ep);
        end;
        BindOTListener := err;
    end;

    procedure EventHandlerOT (btp:TransportRecordPtr; event: OTEventCode; result: OTResult; cookie: univ Ptr);
        var
            junk:OSStatus;
            getprotaddr_resultp: LongIntPtr;
    begin
{$unused(cookie)}
        case event of
            T_OPENCOMPLETE: begin
            end;
            T_ACCEPTCOMPLETE:  begin
                btp^.accept_result := result;
                btp^.accept_received := true;
            end;
            T_PASSCON: begin
                btp^.passcon_result := result;
                btp^.passcon_received := true;
            end;
            T_CONNECT:  begin
                btp^.connect_result := result;
                junk := OTRcvConnect(btp^.ep, @btp^.rcvCall);
                { Assert( junk = noErr ); }
                if junk <> noErr then begin
                    btp^.connect_result := -12345;
                end;
                btp^.connect_received := true;
            end;
            T_DISCONNECT:  begin
                btp^.connect_result := result;
                btp^.disconnect_received := true;
                junk := OTRcvDisconnect( btp^.ep, nil );
                { Assert( junk = noErr ); }
            end;
            T_GETPROTADDRCOMPLETE: begin
                Assert( result <> inProgress );
                getprotaddr_resultp := LongIntPtr( ord4(cookie) - 4 );
                Assert( getprotaddr_resultp^ = inProgress );
                getprotaddr_resultp^ := result
            end;
            T_ORDREL:  begin
                junk := OTRcvOrderlyDisconnect( btp^.ep );
                Assert( junk = noErr );
            end;
            T_DATA, T_GODATA: begin
                if (btp^.wake_process.highLongOfPSN <> 0) or (btp^.wake_process.lowLongOfPSN <> kNoProcess) then begin
                    junk := WakeUpProcess(btp^.wake_process);
                end;
            end;
            T_DISCONNECTCOMPLETE: begin
            end;
            T_MEMORYRELEASED: begin
                if btp^.MemoryReleasedHandler <> nil then begin
                    btp^.MemoryReleasedHandler(TransportRef(btp), result, cookie);
                end;
            end;
            otherwise
                ;
        end;
    end;

    function ValidTransport(tref:TransportRef): Boolean;
        var
            this:TransportRecordPtr;
    begin
        ValidTransport := false;
        this := TransportRecordPtr(transports.qHead);
        while this <> nil do begin
            if TransportRef(this) = tref then begin
                ValidTransport := true;
                leave;
            end;
            this := this^.next;
        end;
    end;

    procedure TransportDestroy(var tref:TransportRef);
        var
            btp:TransportRecordPtr;
            junk:OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        if btp <> nil then begin
            Assert(ValidTransport(tref));
            if TransportSystemIsAlive = noErr then begin
                if have_OT then begin
                    if btp^.ep <> nil then begin
                        MCloseProvider(btp^.ep);
                    end;
                end else begin
                    if btp^.stream <> nil then begin
                        junk := MTTCPRelease(btp^.stream);
                        Assert( junk = noErr );
                    end;
                    MDisposePtr(btp^.stream_buffer);
                    TransportAbortDNR(btp^.dnr_token);
                end;
            end;
            MDisposeHandle(btp^.input_handle);
            MDisposeHandle(btp^.output_handle);
            MDisposeHandle(btp^.sending_handle);
            junk:=Dequeue(QElemPtr(btp),@transports);
            Assert( junk = noErr );
            MDisposePtr(btp);
            tref := nil;
        end;
    end;

    function TransportCreate(var btp:TransportRecordPtr; buffer_size:longint):OSStatus;
        var
            err:OSStatus;
            hack_mrp: MemoryReleasedProc;
    begin
        hack_mrp := hack_MemoryReleasedProc;
        hack_MemoryReleasedProc := nil;
        buffer_size := Pin(10240, buffer_size, 64512);
        btp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(btp, SizeOf(TransportRecord));
            if err = noErr then begin
                Enqueue(QElemPtr(btp),@transports);
                btp^.input_handle := nil;
                btp^.output_handle := nil;
                btp^.sending_handle := nil;
                btp^.max_input_handle_size := 10240;
                if have_OT then begin
                    btp^.MemoryReleasedHandler := hack_mrp;
                    btp^.wake_process.highLongOfPSN := 0;
                    btp^.wake_process.lowLongOfPSN := kNoProcess;
                    btp^.waiting_for_connect := false;
                    btp^.connect_received := false;
                    btp^.accept_received := false;
                    btp^.passcon_received := false;
                    btp^.disconnect_received := false;
                    err := CreateOTEndpoint(btp^.ep, OTCreateConfiguration( "tcp" ), @EventHandlerOT, btp);
                    if (err = noErr) & (btp^.MemoryReleasedHandler <> nil) then begin
                        err := OTAckSends(btp^.ep);
                    end;
                end else begin
                    btp^.dnr_token := nil;
                    btp^.stream := nil;
                    btp^.send_cb.ioResult := noErr;
                    err := MNewPtr(btp^.stream_buffer, buffer_size);
                    if err = noErr then begin
                        err := MTTCPCreate(btp^.stream, btp^.stream_buffer, buffer_size);
                    end;
                end;
                btp^.started_opening := false;
                btp^.handle_receives := false;
                btp^.handle_sends := false;
                btp^.do_send_close := false;
                btp^.send_error := noErr;
                btp^.open_result := inProgress;
                btp^.tstate := T_Bored;
                btp^.receive_error := noErr;
                if err <> noErr then begin
                    TransportDestroy(TransportRef(btp));
                end;
            end;
        end;
        TransportCreate := err;
    end;

    function TransportHandleReceives(tref:TransportRef): OSStatus;
        var
            err, junk: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := noErr;
        if not btp^.handle_receives then begin
            junk := GetCurrentProcess(btp^.wake_process);
            Assert( junk = noErr );
            err := MNewHandle(btp^.input_handle, 0);
            btp^.handle_receives := err = noErr;
        end;
        TransportHandleReceives := err;
    end;

    function TransportHandleSends(tref:TransportRef): OSStatus;
        var
            err, err2: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := noErr;
        if not btp^.handle_sends then begin
            err := MNewHandle(btp^.output_handle, 0);
            err2 := MNewHandle(btp^.sending_handle, 0);
            if err = noErr then begin
                err := err2;
            end;
            btp^.handle_sends := err = noErr;
        end;
        TransportHandleSends := err;
    end;

    function TransportHandleTransfers(tref:TransportRef): OSStatus;
        var
            err: OSStatus;
    begin
        err := TransportHandleReceives(tref);
        if err = noErr then begin
            err :=TransportHandleSends(tref);
        end;
        TransportHandleTransfers := err;
    end;

    function TransportOpenActiveConnection(var tref:TransportRef; dest:Str255; localport:ipPort; buffer_size:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
            portstr:Str255;
            n:longint;
    begin
        err := TransportCreate(btp, buffer_size);
        if err = noErr then begin
            if have_OT then begin
                err := BindOTListener(btp^.ep, localport, 0);
                if err = noErr then begin
                    err:=OTSetAsynchronous(btp^.ep);
                end;
                if err = noErr then begin
                    MZero(@btp^.rcvCall, sizeof(btp^.rcvCall));
                    OTInitNetbuf(btp^.rcvCall.addr, @btp^.rcvsin, sizeof(InetAddress));

                    MZero(@btp^.sndCall, sizeof(btp^.sndCall));
                    P2C(@dest);
                    OTInitNetbuf(btp^.sndCall.addr, @btp^.sndsin, OTInitDNSAddress(btp^.sndsin, @dest));

                    err := OTConnect(btp^.ep, @btp^.sndCall, @btp^.rcvCall);
                    if err = kOTNoDataErr then begin
                        err := noErr;
                    end;
                end;
            end else begin
                SplitBy (dest, ':', dest, portstr);
                StringToNum(portstr, n);
                btp^.remote_port := n;
                btp^.local_port := localport;
                err := TransportNameToAddr(dest, btp^.dnr_token);
            end;
            btp^.started_opening := true;
            if err <> noErr then begin
                TransportDestroy(TransportRef(btp));
            end;
        end;
        tref := TransportRef(btp);
        TransportOpenActiveConnection := err;
    end;

    function TransportOpenPassiveConnection(var tref:TransportRef; var localport:ipPort; buffer_size:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err:OSStatus;
    begin
        err := TransportCreate(btp, buffer_size);
        if err = noErr then begin
            if have_OT then begin
                btp^.waiting_for_connect := true;
                err := BindOTListener(btp^.ep, localport, 1);
            end else begin
                err := MTTCPPassiveOpen(btp^.open_cb, btp^.stream, localport);
            end;
            btp^.started_opening := true;
            if err <> noErr then begin
                TransportDestroy(TransportRef(btp));
            end;
        end;
        tref := TransportRef(btp);
        TransportOpenPassiveConnection := err;
    end;

    procedure TransportGetOpenResult(tref:TransportRef; var result: OSStatus);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        result := btp^.open_result
    end;

    procedure ProcessOpen(btp:TransportRecordPtr);
        var
            addr:ipAddr;
            result: OSStatus;
    begin
        Assert(btp <> nil);
        if btp^.started_opening & (btp^.open_result = inProgress) then begin
            if have_OT then begin
                if btp^.waiting_for_connect then begin
                    MZero(@btp^.rcvCall, sizeof(btp^.rcvCall));
                    OTInitNetbuf(btp^.rcvCall.addr, @btp^.rcvsin, sizeof(InetAddress));
                    result := OTListen(btp^.ep, @btp^.rcvCall);
                    if result = kOTNoDataErr then begin
                        result := inProgress;
                    end else begin
                        btp^.waiting_for_connect := false;
                        if result = noErr then begin
                            result := OTAccept(btp^.ep, btp^.ep, @btp^.rcvCall);
                        end;
                    end;
                end else if btp^.disconnect_received then begin
                    result := connectionDoesntExistErr;
                end else if btp^.connect_received then begin
                    result := btp^.connect_result;
                end else if btp^.accept_received then begin
                    result := btp^.accept_result;
                end else if btp^.passcon_received then begin
                    result := btp^.passcon_result;
                end else begin
                    result := inProgress;
                end;
            end else begin
                result := noErr;
                if btp^.dnr_token <> nil then begin
                    TransportGetNameToAddrResult(btp^.dnr_token, result, nil, @addr, 1);
                    if result = noErr then begin
                        result := MTTCPActiveOpen(btp^.open_cb, btp^.stream, btp^.local_port, addr, btp^.remote_port);
                    end;
                end;
                if result = noErr then begin
                    result := btp^.open_cb.ioResult;
                end;
            end;
            btp^.open_result := result;
        end;
    end;

    procedure IdleReceive(btp:TransportRecordPtr);
        var
            err: OSStatus;
            result: OTResult;
            flags:OTFlags;
            cb:TCPControlBlock;
            len, count: longint;
    begin
        if btp^.handle_receives then begin
            len := MGetHandleSize(btp^.input_handle);
            if have_OT then begin
                if len < btp^.max_input_handle_size then begin
                    result := OTRcv(btp^.ep, idle_space, Min( btp^.max_input_handle_size-len, GetPtrSize(idle_space) ), flags);
                    if result >= 0 then begin
                        err := PtrAndHand(idle_space, btp^.input_handle, result);
                    end else begin
                        case result of
                            kOTNoDataErr: begin
                                err := noErr;
                            end;
                            kOTOutStateErr: begin
                                err := connectionClosingErr;
                            end;
                            otherwise begin
                                err := result;
                            end;
                        end;
                    end;
                    if err <> noErr then begin
                        btp^.receive_error := err;
                    end;
                end;
            end else begin
                MTZeroTCPCB(cb, btp^.stream, TCPcsStatus);
                err := PBControlSync(@cb);
                if err = noErr then begin
                    count := Min(cb.status.amtUnreadData, 10240 - len);
                    if count > 0 then begin
                        err := MSetHandleSize(btp^.input_handle, len + count);
                        if err = noErr then begin
                            HLock(btp^.input_handle);
                            MTZeroTCPCB(cb, btp^.stream, TCPcsRcv);
                            cb.receive.rcvBuff := btp^.input_handle^;
                            cb.receive.rcvBuffLength := count;
                            err := PBControlSync(@cb);
                            count := cb.receive.rcvBuffLength;
                            HUnlock(btp^.input_handle);
                        end;
                        if err <> noErr then begin
                            count := 0;
                            btp^.receive_error := err;
                        end;
                        SetHandleSize(btp^.input_handle, len + count);
                    end else begin
                        if MTMapState( cb.status.connectionState ) in [T_Dead, T_Bored, T_PleaseClose] then begin
                            err := connectionClosingErr;
                        end;
                    end;
                end;
            end;
        end;
    end;

    function TransportCharsAvailable(tref:TransportRef): longint;
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(btp^.handle_receives);
        TransportCharsAvailable := MGetHandleSize(btp^.input_handle);
    end;

    function TransferPeekCharsAvailable(tref:TransportRef; const look: Str255): longint;
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(btp^.handle_receives);
        TransferPeekCharsAvailable := MMungerFindString( btp^.input_handle, 0, look );
    end;

    function TransportReceive(tref:TransportRef; buf: Ptr; len:longint; var count:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
            size: longint;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(btp^.handle_receives);
        size := MGetHandleSize(btp^.input_handle);
        if size > 0 then begin
            err := noErr;
            count := Min(len, size);
            if count > 0 then begin
                BlockMoveData(btp^.input_handle^, buf, count);
                MMungerDelete(btp^.input_handle, 0, count);
            end;
        end else if btp^.receive_error = noErr then begin
            err := noErr;
            count := 0;
        end else begin
            err := btp^.receive_error;
            btp^.receive_error := noErr;
            count := 0;
        end;
        TransportReceive := err;
    end;

    function TransportSend(tref:TransportRef; buf: Ptr; len:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        if not btp^.handle_sends then begin
            err := -900005; { I'd like to know why this actually occurs }
        end else begin
            err := PtrAndHand(buf, btp^.output_handle, len);
            if err = noErr then begin
                err := btp^.send_error;
                btp^.send_error:= noErr;
            end;
        end;
        TransportSend := err;
    end;

    function TransportSendQueued(tref:TransportRef): longint;
        var
            btp:TransportRecordPtr;
            result: longint;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        if not btp^.handle_sends then begin
            result := 0;
        end else begin
            result := MGetHandleSize( btp^.output_handle );
        end;
        TransportSendQueued := result;
    end;

    procedure IdleSend(btp: TransportRecordPtr);
        procedure SwapHandles(var h1, h2:Handle);
            var
                tmph:Handle;
        begin
            tmph := h1;
            h1 := h2;
            h2 := tmph;
        end;
        var
            err: OSStatus;
            result: OTResult;
            len:longint;
    begin
        if btp^.handle_sends then begin
            len := MGetHandleSize(btp^.output_handle);
            if btp^.do_send_close & (len = 0) then begin
                btp^.handle_sends := false;
                TransportSendClose(TransportRef(btp));
            end else begin
                if have_OT then begin
                    if len > 0 then begin
                        HLock(btp^.output_handle);
                        result := OTSnd(btp^.ep, btp^.output_handle^, len, 0);
                        HUnlock(btp^.output_handle);
                        if result >= 0 then begin
                            MMungerDelete(btp^.output_handle, 0, result);
                        end else if result <> kOTFlowErr then begin
                            btp^.send_error := result;
                            SetHandleSize(btp^.output_handle, 0);
                        end;
                    end;
                end else begin
                    if btp^.send_cb.ioResult <> inProgress then begin
                        HUnlock(btp^.sending_handle);
                        SetHandleSize(btp^.sending_handle, 0);
                        if btp^.send_cb.ioResult <> noErr then begin
                            btp^.send_error := btp^.send_cb.ioResult;
                            btp^.send_cb.ioResult := noErr;
                        end;
                        if len > 0 then begin
                            SwapHandles(btp^.output_handle, btp^.sending_handle);
                            HLock(btp^.sending_handle);
                            btp^.send_wds.buffer := btp^.sending_handle^;
                            btp^.send_wds.size := len;
                            btp^.send_wds.term := 0;
                            MTZeroTCPCB(btp^.send_cb, btp^.stream, TCPcsSend);
                            btp^.send_cb.send.wds := @btp^.send_wds;
                            btp^.send_cb.send.pushFlag := 1;
                            err := PBControlAsync(@btp^.send_cb);
                        end;
                    end;
                end;
            end;
        end;
    end;

    procedure TransportSendClose(tref:TransportRef);
        var
            btp:TransportRecordPtr;
            err: OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := TransportSystemIsAlive;
        if err = noErr then begin
            if btp^.handle_sends then begin
                btp^.do_send_close := true;
                IdleSend(btp);
            end else begin
                if have_OT then begin
                    err := OTSndOrderlyDisconnect(btp^.ep);
                end else begin
                    err := MTTCPClose(btp^.close_cb, btp^.stream);
                end;
            end;
        end;
    end;

    function TransportGetConnectionStateInteruptSafe (tref:TransportRef): TCPStateType; { * }
        var
            btp:TransportRecordPtr;
            state:TCPStateType;
    begin
        btp := TransportRecordPtr(tref);
        if (btp = nil) then begin {  | (TransportSystemIsAlive <> noErr) }
            state := T_Dead;
        end else if have_OT then begin
            state := TransportGetConnectionStateOT(btp^.ep);
        end else begin
            state := btp^.tstate;
        end;
        TransportGetConnectionStateInteruptSafe := state;
    end;

    procedure IdleMacTCPConnectionState(btp:TransportRecordPtr);
    begin
        Assert(not have_OT);
        if btp^.dnr_token <> nil then begin
            btp^.tstate := T_Opening;
        end else if btp^.stream = nil then begin
            btp^.tstate := T_Dead;
        end else begin
            btp^.tstate := MTTCPState(btp^.stream);
        end;
    end;

    function TransportGetConnectionState (tref:TransportRef): TCPStateType;
        var
            btp:TransportRecordPtr;
            state:TCPStateType;
    begin
        btp := TransportRecordPtr(tref);
        if (btp = nil) | (TransportSystemIsAlive <> noErr) then begin
            state := T_Dead;
        end else if have_OT then begin
            state := TransportGetConnectionStateOT(btp^.ep);
        end else begin
            btp^.tstate := MTTCPState(btp^.stream);
            state := btp^.tstate;
        end;
        TransportGetConnectionState := state;
    end;

    procedure TransportLowGetStreamPtr(tref:TransportRef; var stream: StreamPtr);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(not have_OT);
        stream := btp^.stream;
    end;

    procedure TransportLowGetEndpointRef(tref:TransportRef; var ep: EndpointRef);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(have_OT);
        Assert(ValidTransport(tref));
        ep := btp^.ep;
    end;

    function TransportLowSetOTAckSends(tref:TransportRef; handler: MemoryReleasedProc): OSStatus;
        var
            err: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(have_OT);
        err := OpenTransportSystem;
        if err = noErr then begin
            if btp^.MemoryReleasedHandler = nil then begin
                err := OTAckSends(btp^.ep);
            end;
            if err = noErr then begin
                btp^.MemoryReleasedHandler := handler;
            end;
        end;
        TransportLowSetOTAckSends := err;
    end;

    function SafeOTGetPortsSync( btp: TransportRecordPtr; var localip: ipAddr; var localport: ipPort; var remoteip: ipAddr; var remoteport: ipPort): OSStatus;
        type
            HackBindRecord = record
                    localBind: TBind;
                    result: OSStatus; { must preceed peer address! }
                    remoteBind: TBind;
                    localAddr: InetAddress;
                    remoteAddr: InetAddress;
                end;
            HackBindRecordPtr = ^HackBindRecord;

        var
            err: OSStatus;
            bind: HackBindRecordPtr;
            timeout: longint;
    begin
        err := MNewPtr( bind, SizeOf(HackBindRecord) );
        if err = noErr then begin
            bind^.result := inProgress;
            OTInitNetbuf(bind^.localBind.addr, @bind^.localAddr, SizeOf(bind^.localAddr));
            OTInitNetbuf(bind^.remoteBind.addr, @bind^.remoteAddr, SizeOf(bind^.remoteAddr));
            err := OTGetProtAddress(btp^.ep, @bind^.localBind, @bind^.remoteBind);
            if err = noErr then begin
                timeout := TickCount + 10;
                while (TickCount < timeout) & (bind^.result = inProgress) do begin
                    OTIdle;
                end;
                if bind^.result = inProgress then begin
                    err := commandTimeoutErr;
{$ifc do_debug}
                    DebugStr( 'NetPresenz:SafeOTGetPortsSync: Abandoning BindRecord;g' );
{$endc}
                    { abandon the ptr, sigh }
                end else begin
                    err := bind^.result;
                    localip := bind^.localAddr.fHost;
                    localport := bind^.localAddr.fPort;
                    remoteip := bind^.remoteAddr.fHost;
                    remoteport := bind^.remoteAddr.fPort;
                    MDisposePtr( bind );
                end;
            end;
        end;
        SafeOTGetPortsSync := err;
    end;

    function TransportGetPorts(tref:TransportRef; var localip: ipAddr; var localport: ipPort; var remoteip: ipAddr; var remoteport: ipPort): OSStatus;
        var
            err: OSStatus;
            btp: TransportRecordPtr;
            cb: TCPControlBlock;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := TransportSystemIsAlive;
        if err = noErr then begin
            if have_OT then begin
                err := SafeOTGetPortsSync( btp, localip, localport, remoteip, remoteport );
            end else begin
                MTZeroTCPCB(cb, btp^.stream, TCPcsStatus);
                err := PBControlSync(@cb);
                if err = noErr then begin
                    localip := cb.status.localhost;
                    localport := cb.status.localport;
                    remoteip := cb.status.remotehost;
                    remoteport := cb.status.remoteport;
                end;
            end;
        end;
        if err <> noErr then begin
            localip := 0;
            localport := 0;
            remoteip := 0;
            remoteport := 0;
        end;
        TransportGetPorts := err;
    end;

    const
        max_tcp_listeners = 20;

    type
        OTSequenceArray = array[0..1000] of OTSequence;
        OTSequenceArrayPtr = ^OTSequenceArray;
        OTSequenceArrayHandle = ^OTSequenceArrayPtr;

    type
        TransportListenRecord = record
            localport: ipPort;
            case boolean of
            false:(
                mt_buffer_size:longint;
                mt_listeners_count:integer;
                mt_listeners:array[1..max_tcp_listeners] of TransportRef;
            )
            true:(
                ep: EndpointRef;
                sequences: OTSequenceArrayHandle;
            )
        end;
        TransportListenRecordPtr = ^TransportListenRecord;

    function TransportListen(var token:Ptr; localport:ipPort; listeners:integer; buffer_size:longint):OSStatus;
        var
            lp:TransportListenRecordPtr;
            err, junk:OSStatus;
            i:integer;
    begin
        lp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(lp, SizeOf(TransportListenRecord));
            if err = noErr then begin
                lp^.localport := localport;
                if have_OT then begin
                    err := MNewHandle(lp^.sequences, 0);
                    if err = noErr then begin
                        if false & (ot_version >= kOTTILISTENVersion) then begin
                            err := CreateOTEndpoint(lp^.ep, OTCreateConfiguration( "tilisten, tcp" ), nil, lp);
                        end else begin
                            err := -1;
                        end;
                        if err <> noErr then begin
                            err := CreateOTEndpoint(lp^.ep, OTCreateConfiguration( "tcp" ), nil, lp);
                        end;
                        if err = noErr then begin
                            err := BindOTListener(lp^.ep, localport, 99);
                            if err <> noErr then begin
                                junk := OTCloseProvider(lp^.ep);
                            end;
                        end;
                        if err <> noErr then begin
                            MDisposeHandle(lp^.sequences);
                        end;
                    end;
                end else begin
                    lp^.mt_listeners_count := listeners;
                    lp^.mt_buffer_size := buffer_size;
                    for i := 1 to lp^.mt_listeners_count do begin
                        lp^.mt_listeners[i] := nil;
                    end;
                end;
            end;
        end;
        if err <> noErr then begin
            MDisposePtr(lp);
        end;
        token := Ptr(lp);
        TransportListen := err;
    end;
{
    procedure ReopenTransportListener(lp:TransportListenRecordPtr);
        var
            err, junk: OSErr;
            newep: EndpointRef;
    begin
        err := CreateOTEndpoint(newep, nil, lp);
        if err = noErr then begin
            err := BindOTListener(newep, lp^.localport, 99);
            if err <> noErr then begin
                junk := OTCloseProvider(newep);
            end;
        end;
        if err = noErr then begin
            junk := OTCloseProvider(lp^.ep);
            lp^.ep := newep;
        end;
    end;
}
    function TransportGetListenerConnectionOT(lp:TransportListenRecordPtr; var tref:TransportRef):OSStatus;
        function CountSequences: longint;
        begin
            CountSequences := MGetHandleSize(Handle(lp^.sequences)) div SizeOf(OTSequence);
        end;

        procedure DelSequence(sequence: OTSequence);
            var
                i: longint;
        begin
            for i := 0 to CountSequences - 1 do begin
                if lp^.sequences^^[i] = sequence then begin
                    MMungerDelete(Handle(lp^.sequences), i * SizeOf(OTSequence), SizeOf(OTSequence));
                    Exit(DelSequence);
                end;
            end;
            Assert( false );
        end;
        label
            1;
        var
            err: OSStatus;
            result: OTResult;
            rcvCall:TCall;
            rcvsin:InetAddress;
            btp:TransportRecordPtr;
            discon: TDiscon;
            sequence: OTSequence;
    begin
        1:
        repeat
            MZero(@rcvCall, sizeof(rcvCall));
            OTInitNetbuf(rcvCall.addr, @rcvsin, sizeof(InetAddress));
            result := OTListen(lp^.ep, @rcvCall);
            if result = noErr then begin
                sequence := rcvCall.sequence;
                result := PtrAndHand(@sequence, Handle(lp^.sequences), SizeOf(sequence));
            end else if result = kOTLookErr then begin
                MZero(@discon, sizeof(discon));
                result := OTRcvDisconnect(lp^.ep, @discon);
                if result = noErr then begin
                    DelSequence(discon.sequence);
                end;
{                end else if result = kOTOutStateErr then begin
                ReopenTransportListener( lp );}
            end;
        until result <> noErr;
        if result <> kOTNoDataErr then begin
            err := result;
        end else begin
            if CountSequences = 0 then begin
                err := inProgress;
            end else begin
                err := TransportCreate(btp, 0);
                if err = noErr then begin
                    tref := TransportRef(btp);
                    btp^.started_opening := true;
                    MZero(@rcvCall, sizeof(rcvCall));
                    rcvCall.sequence := lp^.sequences^^[0];
                    err := OTAccept(lp^.ep, btp^.ep, @rcvCall);
                    if err = kOTLookErr then begin
                        TransportDestroy(tref);
                        goto 1;
                    end else begin
                        MMungerDelete(Handle(lp^.sequences), 0, SizeOf(OTSequence));
                    end;
                    if err = noErr then begin
                        err:=OTSetAsynchronous(btp^.ep);
                    end;
                    if err <> noErr then begin
                        TransportDestroy(tref);
                    end;
                end;
            end;
        end;
        TransportGetListenerConnectionOT := err;
    end;


(*    function CreateOTListenerEndpoint( var ep: EndpointRef; var localport: ipPort; context: univ Ptr; reuse: boolean ): OSStatus;
        var
            err, junk: OSStatus;
    begin
        if ot_version >= kOTTILISTENVersion then begin
            err := CreateOTEndpoint( ep, OTCreateConfiguration( "tilisten, tcp" ), nil, context );
        end else begin
            err := -1;
        end;
        if err <> noErr then begin
            err := CreateOTEndpoint( ep, OTCreateConfiguration( "tcp" ), nil, context );
        end;
        if err = noErr then begin
            if reuse then begin
                junk := SetReuseAddr( ep );
            end;
            err := BindOTListener( ep, localport, 99 );
            if err <> noErr then begin
                MCloseProvider( ep );
            end;
        end;
        CreateOTListenerEndpoint := err;
    end;

    function TransportListen(var token:Ptr; localport:ipPort; listeners:integer; buffer_size:longint):OSStatus;
        var
            lp:TransportListenRecordPtr;
            err:OSStatus;
            i:integer;
    begin
        lp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(lp, SizeOf(TransportListenRecord));
            if err = noErr then begin
                lp^.localport := localport;
                if have_OT then begin
                    err := MNewHandle(lp^.sequences, 0);
                    if err = noErr then begin
                        err := CreateOTListenerEndpoint( lp^.ep, localport, lp, false );
                        if err <> noErr then begin
                            MDisposeHandle(lp^.sequences);
                        end;
                    end;
                end else begin
                    lp^.mt_listeners_count := listeners;
                    lp^.mt_buffer_size := buffer_size;
                    for i := 1 to lp^.mt_listeners_count do begin
                        lp^.mt_listeners[i] := nil;
                    end;
                end;
            end;
        end;
        if err <> noErr then begin
            MDisposePtr(lp);
        end;
        token := Ptr(lp);
        TransportListen := err;
    end;

    procedure ReopenTransportListener(lp:TransportListenRecordPtr);
        var
            err: OSErr;
            newep: EndpointRef;
    begin
        err := CreateOTListenerEndpoint( newep, lp^.localport, lp, true );
        if err = noErr then begin
            MCloseProvider( lp^.ep );
            lp^.ep := newep;
            SetHandleSize( Handle(lp^.sequences), 0 );
        end;
    end;

    var
        next_listener_connection: TransportRecordPtr;

    procedure ListenerNotifier( up: boolean );
    begin
        if not up & (next_listener_connection <> nil) then begin
            TransportDestroy(TransportRef(next_listener_connection));
        end;
    end;

    function TransportGetListenerConnectionOT(lp:TransportListenRecordPtr; var tref:TransportRef):OSStatus;

        procedure DoRcvDisconnect( ep: EndpointRef );
            var
                junk: OSStatus;
        begin
            junk := OTRcvDisconnect( ep, nil );
            Assert( junk = noErr );
        end;

        procedure HandleLookError( err: OSStatus; ep: EndpointRef );
            var
                result: OTResult;
        begin
            if err <> noErr then begin
                result := OTLook( ep );
                if (err = kOTLookErr) & (result = T_DISCONNECT) then begin
                    DoRcvDisconnect( lp^.ep );
                end;
            end;
        end;

        var
            err: OSStatus;
            call:TCall;
            caddr:InetAddress;
    begin
        err := noErr;
        if next_listener_connection = nil then begin
            err := TransportCreate(next_listener_connection, 0);
        end;
        if err = noErr then begin
            MZero( @call, sizeof(call) );
            OTInitNetbuf( call.addr, @caddr, sizeof(caddr) );
            err := OTListen( lp^.ep, @call );
            HandleLookError( err, lp^.ep );
            if err = kOTNoDataErr then begin
                err := inProgress;
            end else if err = noErr then begin
                err := OTAccept( lp^.ep, next_listener_connection^.ep, @call );
                HandleLookError( err, lp^.ep );
                if err = noErr then begin
                    tref := TransportRef(next_listener_connection);
                    next_listener_connection^.started_opening := true;
                    err:=OTSetAsynchronous(next_listener_connection^.ep);
                    Assert( err = noErr );
                    next_listener_connection := nil;
                end;
            end;
        end;
        TransportGetListenerConnectionOT := err;
    end;


    function TransportGetListenerConnectionOT(lp:TransportListenRecordPtr; var tref:TransportRef):OSStatus;
        function CountSequences: longint;
        begin
            CountSequences := MGetHandleSize(Handle(lp^.sequences)) div SizeOf(OTSequence);
        end;

        procedure DelSequence(sequence: OTSequence);
            var
                i: longint;
        begin
            for i := 0 to CountSequences - 1 do begin
                if lp^.sequences^^[i] = sequence then begin
                    MMungerDelete(Handle(lp^.sequences), i * SizeOf(OTSequence), SizeOf(OTSequence));
                    Exit(DelSequence);
                end;
            end;
            Assert( false );
        end;
        label
            1;
        var
            err: OSStatus;
            result: OTResult;
            rcvCall:TCall;
            rcvsin:InetAddress;
            btp:TransportRecordPtr;
            discon: TDiscon;
            sequence: OTSequence;
    begin
        1:
        repeat
            MZero(@rcvCall, sizeof(rcvCall));
            OTInitNetbuf(rcvCall.addr, @rcvsin, sizeof(InetAddress));
            err := OTListen(lp^.ep, @rcvCall);
            if err = noErr then begin
                sequence := rcvCall.sequence;
                err := PtrAndHand(@sequence, Handle(lp^.sequences), SizeOf(sequence));
                Assert( err = noErr );
            end else if err <> kOTNoDataErr then begin
                result := OTLook( lp^.ep );
                if result = T_DISCONNECT then begin
                    MZero(@discon, sizeof(discon));
                    result := OTRcvDisconnect(lp^.ep, @discon);
                    if result = noErr then begin
                        DelSequence(discon.sequence);
                    end else begin
{$ifc do_debug}
                        Assert( false );
                        result := OTGetEndpointState(lp^.ep);
{$endc}
                        ReopenTransportListener( lp );
                    end;
                end else begin
{$ifc do_debug}
                    Assert( false );
                    result := OTGetEndpointState(lp^.ep);
{$endc}
                    ReopenTransportListener( lp );
                end;
{                end else if err = kOTOutStateErr then begin
                ReopenTransportListener( lp );}
            end;
        until err <> noErr;
        if CountSequences > 0 then begin
            err := TransportCreate(btp, 0);
            if err = noErr then begin
                tref := TransportRef(btp);
                btp^.started_opening := true;
                MZero(@rcvCall, sizeof(rcvCall));
                rcvCall.sequence := lp^.sequences^^[0];
                err := OTAccept(lp^.ep, btp^.ep, @rcvCall);
                if err = kOTLookErr then begin
                    TransportDestroy(tref);
                    goto 1;
                end else begin
                    MMungerDelete(Handle(lp^.sequences), 0, SizeOf(OTSequence));
                end;
                if err = noErr then begin
                    err:=OTSetAsynchronous(btp^.ep);
                end;
                if err <> noErr then begin
                    TransportDestroy(tref);
                end;
            end;
        end else if err = kOTNoDataErr then begin
            err := inProgress;
        end else begin
{$ifc do_debug}
            Assert( false );
            result := OTGetEndpointState(lp^.ep);
{$endc}
            ReopenTransportListener( lp );
        end;
        TransportGetListenerConnectionOT := err;
    end;
*)

    function TransportGetListenerConnection(token:Ptr; var tref:TransportRef):OSStatus;
        var
            err, result:OSStatus;
            lp:TransportListenRecordPtr;
            i:integer;
    begin
        lp := TransportListenRecordPtr(token);
        if lp = nil then begin
            err := -900007;
        end else begin
            err := TransportSystemIsAlive;
            if err = noErr then begin
                err := inProgress;
                if have_OT then begin
                    err := TransportGetListenerConnectionOT(lp, tref);
                end else begin
                    for i := 1 to lp^.mt_listeners_count do begin
                        if (lp^.mt_listeners[i] = nil) & EnoughSpace(100000, 70000) then begin
                            err := TransportOpenPassiveConnection(lp^.mt_listeners[i], lp^.localport, lp^.mt_buffer_size);
                            leave; { only create one listener, that allows the listeners to be shared a bit better }
                        end;
                    end;

                    err := inProgress;
                    for i := 1 to lp^.mt_listeners_count do begin
                        if (lp^.mt_listeners[i] <> nil) then begin
                            Assert(ValidTransport(lp^.mt_listeners[i]));
                            TransportGetOpenResult(lp^.mt_listeners[i], result);
                            case result of
                                inProgress: begin
                                end;
                                noErr:begin
                                    tref := lp^.mt_listeners[i];
                                    lp^.mt_listeners[i] := nil;
                                    err := noErr;
                                    leave;
                                end;
                                otherwise begin
                                    TransportDestroy(lp^.mt_listeners[i]);
                                end;
                            end;
                        end;
                    end;
                end;
            end;
        end;
        if err <> noErr then begin
            tref := nil;
        end;
        TransportGetListenerConnection := err;
    end;

    procedure TransportDestroyListener(var token:Ptr);
        var
            err:OSStatus;
            lp:TransportListenRecordPtr;
            i:integer;
    begin
        err := TransportSystemIsAlive;
        if err = noErr then begin
            lp := TransportListenRecordPtr(token);
            if lp <> nil then begin
                if have_OT then begin
                    MCloseProvider(lp^.ep);
                    MDisposeHandle(lp^.sequences);
                end else begin
                    for i := 1 to lp^.mt_listeners_count do begin
                        TransportDestroy(lp^.mt_listeners[i]);
                    end;
                    lp^.mt_listeners_count := 0;
                end;
                MDisposePtr(token);
            end;
        end;
    end;

    function CreateOTUDPEndpoint(var ep:EndpointRef; proc:OTNotifyProcPtr; var localport: ipPort; context:univ Ptr):OSErr;
        var
            err: OSStatus;
            reqsin, retsin:InetAddress;
            req, ret:TBind;
    begin
        ep:=OTOpenEndpoint(OTCreateConfiguration("udp"),0,nil,err);
        if (err = noErr) & (proc <> nil) then begin
            err:=OTInstallNotifier(ep, proc, context);
        end;

        if err = noErr then begin
            if localport <> 0 then begin
                OTInitInetAddress(reqsin, localport, 0);
                OTInitNetbuf(req.addr, @reqsin, sizeof(InetAddress));
            end else begin
                OTInitNetbuf(req.addr, nil, 0);
            end;
            req.qlen := 1;

            MZero(@ret, sizeof(ret));
            OTInitNetbuf(ret.addr, @retsin, sizeof(InetAddress));
            err := OTBind(ep, @req, @ret);
            localport := retsin.fPort;
        end;
        if (err = noErr) & (localport <> 0) & (localport <> retsin.fPort) then begin
            err := couldNotGetRequestedPortErr;
        end;
        if err = noErr then begin
            err:=OTSetNonBlocking(ep);
        end;
        if err <> noErr then begin
            MCloseProvider(ep);
        end;
        CreateOTUDPEndpoint := err;
    end;

    procedure UDPEventHandlerOT (tup: TransportUDPRecordPtr; event: OTEventCode; result: OTResult; cookie: univ Ptr);
    begin
{$unused(cookie, result)}
        case event of
            T_DATA: begin
                tup^.packets_available := true;
            end;
            otherwise
                ;
        end;
    end;

    function TransportUDPOpenPort(var tref: TransportUDPRef; var localport: ipPort; buffer_size:longint): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        buffer_size := Pin(10240, buffer_size, 64512);
        tup := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tup, SizeOf(TransportUDPRecord));
            if err = noErr then begin
                if have_OT then begin
                    tup^.packets_available := false;
                    err := CreateOTUDPEndpoint(tup^.ep, @UDPEventHandlerOT, localport, tup);
                end else begin
                    tup^.stream := nil;
                    err := MNewPtr(tup^.stream_buffer, buffer_size);
                    if err = noErr then begin
                        err := MTUDPCreate(tup^.stream, localport, @tup^.outstanding_packets, tup^.stream_buffer, buffer_size);
                    end;
                end;
                if err <> noErr then begin
                    TransportUDPDestroy(TransportUDPRef(tup));
                end;
            end;
        end;
        tref := TransportUDPRef(tup);
        TransportUDPOpenPort := err;
    end;

    procedure TransportUDPDestroy (var tref: TransportUDPRef);
        var
            err: OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        if tup <> nil then begin
            if  TransportSystemIsAlive = noErr then begin
                if have_OT then begin
                    if tup^.ep <> nil then begin
                        MCloseProvider(tup^.ep);
                    end;
                end else begin
                    if tup^.stream <> nil then begin
                        err := MTUDPRelease(tup^.stream);
                    end;
                    MDisposePtr(tup^.stream_buffer);
                end;
            end;
            MDisposePtr(tup);
            tref := nil;
        end;
    end;

    const
        max_udp_datalen = 2048;

    function TransportUDPDatagramsAvailable (tref: TransportUDPRef): longint;
        var
            tup: TransportUDPRecordPtr;
    begin
Assert( false ); { check tup^.packets_available code }

        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if have_OT then begin
            TransportUDPDatagramsAvailable := Choose( tup^.packets_available, 1, 0 );
        end else begin
            TransportUDPDatagramsAvailable := tup^.outstanding_packets;
        end;
    end;

    function TransportUDPRead (tref: TransportUDPRef; var remoteip: longint; var remoteport: ipPort;
                                    var datap: Ptr; var datalen: integer): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
            udata:TUnitData;
            flags: OTFlags;
            srcsin: InetAddress;
    begin
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        err := TransportSystemIsAlive;
        if  err = noErr then begin
            if have_OT then begin
                err := MNewPtr(datap, max_udp_datalen);
                if err = noErr then begin
                    MZero(@udata, SizeOf(udata));
                    OTInitNetbuf(udata.addr, @srcsin, SizeOf(srcsin));
                    OTInitNetbuf(udata.udata, datap, max_udp_datalen);
                    tup^.packets_available := false;
                    err := OTLFRcvUData(tup^.ep,udata, flags);
                    if err = noErr then begin
                        tup^.packets_available := true;
                        datalen := udata.udata.len;
                        remoteip := srcsin.fHost;
                        remoteport := srcsin.fPort;
                    end;
                end;
                if err <> noErr then begin
                    MDisposePtr(datap);
                end;
            end else begin
                err := MTUDPRead(tup^.stream, @tup^.outstanding_packets, remoteip, remoteport, datap, datalen);
            end;
        end;
        TransportUDPRead := err;
    end;

    function TransportUDPReturnBuffer (tref: TransportUDPRef; datap: Ptr): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if tup <> nil then begin
            if have_OT then begin
                MDisposePtr(datap);
            end else begin
                err := MTUDPReturnBuffer(tup^.stream, datap);
            end;
        end;
        TransportUDPReturnBuffer := err;
    end;

    function TransportUDPWrite (tref: TransportUDPRef; remoteip: longint; remoteport: ipPort;
                                    datap: Ptr; datalen: integer; checksum: boolean): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
            udata:TUnitData;
            destsin: InetAddress;

            junk_result: OTResult;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if tup <> nil then begin
            err := TransportSystemIsAlive;
            if  err = noErr then begin
                if have_OT then begin
                    MZero(@udata, SizeOf(udata));
                    OTInitInetAddress(destsin, remoteport, remoteip);
                    OTInitNetbuf(udata.addr, @destsin, SizeOf(destsin));
                    OTInitNetbuf(udata.udata, datap, datalen);
                    err := OTLFSndUData(tup^.ep,udata);

                    if err = kOTLookErr then begin
                    Assert( false );
                    junk_result := OTLook( tup^.ep );
                    end;
                end else begin
                    err := MTUDPWrite(tup^.stream, remoteip, remoteport, datap, datalen, checksum);
                end;
            end;
        end;
        TransportUDPWrite := err;
    end;

    var
        rawip: EndpointRef;
        icmps: QHdr;
        delayed_close_time: longint;
        ping_id: UInt16;
        ping_sequence: UInt16;

{$PUSH}
{$ALIGN MAC68K}
    type
        PingMessage = packed record
                typ: UInt8;
                code: UInt8;
                checksum: UInt16;
                id: UInt16;
                sequence: UInt16;
            end;
        PingMessagePtr = ^PingMessage;
{$ALIGN RESET}
{$POP}

    type
        TransportSendPingData = record
                completion: PingCompletionProc; { MacTCP } { must be first entry in record! }
                qlink: TransportSendPingDataPtr; { OT }
                result: OSStatus;
                results: TransportPingResults;
                { OT only }
                id: UInt16;
                sequence: UInt16;
                timeout: longint;
                dead: boolean;
                start_time: UnsignedWide;
            end;
        TransportSendPingDataPtr = ^TransportSendPingData;

    procedure EnquePing( ted: TransportSendPingDataPtr );
    begin
        Assert( ted <> nil );
        Enqueue( @ted^.qlink, @icmps );
    end;

    procedure DequePing( ted: TransportSendPingDataPtr );
        var
            junk: OSErr;
    begin
        Assert( ted <> nil );
        junk := Dequeue( @ted^.qlink, @icmps );
        Assert( junk = noErr );
        delayed_close_time := TickCount + 30 * second_in_ticks;
    end;

    function OpenPing: OSErr;
        var
            err: OSStatus;
            info: TEndpointInfo;
    begin
        delayed_close_time := TickCount + 30 * second_in_ticks;
        err := noErr;
        if rawip = nil then begin
            rawip := OTOpenEndpoint( OTCreateConfiguration( "rawip" ), 0, @info, err );
            if err = noErr then begin
                err := OTBind( rawip, nil, nil );
                if err = noErr then begin
                    err := OTSetNonBlocking( rawip );
                end;
                if err <> noErr then begin
                    MCloseProvider( rawip );
                end;
            end;
        end;
        OpenPing := err;
    end;

    procedure CorrectTed( var ted: TransportSendPingDataPtr );
    begin
        if ted <> nil then begin
            OffsetPtr( ted, SubPtrPtr( ted, @ted^.qlink ) );
        end;
    end;

    procedure NextPing( var ted: TransportSendPingDataPtr );
    begin
        if ted = nil then begin
            ted := TransportSendPingDataPtr(icmps.qHead);
        end else begin
            ted := ted^.qlink;
        end;
        CorrectTed( ted );
    end;

    procedure ClosePing( error: OSStatus );
        var
            ted: TransportSendPingDataPtr;
    begin
        ted := nil;
        NextPing( ted );
        while ( ted <> nil ) do begin
            if ted^.result = inProgress then begin
                if have_OT then begin
                    ted^.dead := true;
                end else begin
                    ted^.result := error;
                end;
            end;
            NextPing( ted );
        end;
        if (rawip <> nil) then begin
            MCloseProvider( rawip );
        end;
    end;

    procedure CheckClosePing;
    begin
        if (rawip <> nil) & (icmps.qHead = nil) & (TickCount > delayed_close_time) then begin
            ClosePing( -900009 );
        end;
    end;

    procedure InitPing;
        var
            date: UInt32;
    begin
        rawip := nil;
        icmps.qHead := nil;
        icmps.qTail := nil;
        ping_id := 1000 + band(SInt32(Ord4(TickCount)), $3FFF);
        GetDateTime( date );
        ping_sequence := 1000 + band(date, $3FFF);
    end;

    procedure PingNotifier( up: Boolean );
    begin
        if not up then begin
            ClosePing( -900020 );
        end;
    end;

    procedure Checksum( pm: PingMessagePtr; len: longint );
        var
            sum: longint;
            p: unsignedwordP;
            i: longint;
    begin
        pm^.checksum := 0;
        p := unsignedwordP(pm);
        sum := 0;
        for i := 1 to len div 2 do begin
            sum := sum + p^;
            OffsetPtr( p, 2 );
        end;
        if odd(len) then begin
            sum := sum +bsl(band(integer(p^), $000000FF),8);
        end;
        sum := bsr(sum, 16) + band(sum, $0000FFFF); { should bsr be arithmetic or logical??? }
        sum := sum + bsr(sum, 16);
        pm^.checksum := bnot( sum );
    end;

    function OTSendPing( remoteip: longint; id, sequence: UInt16; buffer: Ptr; bufferlen: longint ): OSStatus;
        var
            err: OSStatus;
            dest: InetAddress;
            udata: TUnitData;
            packet: Ptr;
            pm: PingMessagePtr;
            packet_len: longint;
    begin
        packet_len := SizeOf(PingMessage) + bufferlen;
        packet := NewPtr( packet_len );
        err := MemError;
        if err = noErr then begin
            pm := PingMessagePtr(packet);
            pm^.typ := 8;
            pm^.code := 0;
            pm^.id := id;
            pm^.sequence := sequence;
            BlockMoveData( buffer, AddPtrLong( pm, SizeOf(PingMessage) ), bufferlen );
            Checksum( pm,packet_len );

            OTInitInetAddress( dest, 0, remoteip );
            udata.addr.buf := @dest;
            udata.addr.len := SizeOf(dest);
            udata.opt.buf := nil;
            udata.opt.len := 0;
            udata.udata.buf := packet;
            udata.udata.len := packet_len;
            err := OTLFSndUData( rawip, udata );

            DisposePtr(packet);
        end;
        OTSendPing := err;
    end;

{$PUSH}
{$ALIGN MAC68K}
    type
        IPPacket = packed record
            versize: UInt8;
            junk1: UInt8;
            total_length: UInt16; { broken in OT 1.1 }
            ident: UInt16;
            flags: UInt16;
            ttl: UInt8;
            protocol: UInt8; { ICMP = 1 }
            checksum: UInt16;
            srcIP: ipAddr;
            dstIP: ipAddr;
            { options }
        end;
        IPPacketPtr = ^IPPacket;
{$ALIGN RESET}
{$POP}

    function IsPingResponse( packet: Ptr; packet_len: longint; var remotehost: ipAddr; var pmp: PingMessagePtr; var ping_len: longint ): boolean;
        var
            ipp: IPPacketPtr;
            header_len: longint;
    begin
        IsPingResponse := false;
        if packet_len > 20 then begin
            ipp := IPPacketPtr(packet);
            if (band(ipp^.versize, $00F0) = $0040) then begin
                header_len := band(ipp^.versize, $000F) * 4;
                if (header_len >= 20) & (packet_len >= header_len + SizeOf(PingMessage)) then begin
                    if (ipp^.protocol = 1) then begin
                        pmp := PingMessagePtr(AddPtrLong( ipp, header_len ));
                        if pmp^.typ = 0 then begin { ICMP response }
                            { Check checksum? }
                            IsPingResponse := true;
                            ping_len := packet_len - header_len;
                            remotehost := ipp^.srcIP;
                        end;
                    end;
                end;
            end;
        end;
    end;

    function FindPing( id, sequence: UInt16; var ted: TransportSendPingDataPtr ): boolean;
    begin
        ted := nil;
        NextPing( ted );
        while ted <> nil do begin
            if (ted^.id = id) & (ted^.sequence = sequence) then begin
                leave;
            end;
            NextPing( ted );
        end;
        FindPing := ted <> nil;
    end;

    function ValidPing( check_ted: TransportSendPingDataPtr ): boolean;
        var
            ted: TransportSendPingDataPtr;
    begin
        ted := nil;
        NextPing( ted );
        while ted <> nil do begin
            if ted = check_ted then begin
                leave;
            end;
            NextPing( ted );
        end;
        ValidPing := ted <> nil;
    end;

    procedure KillOTPing( var ted: TransportSendPingDataPtr );
    begin
        DequePing( ted );
        MDisposePtr( ted^.results.data );
        MDisposePtr( ted );
    end;

    procedure KillDeadPings;
        var
            ted: TransportSendPingDataPtr;
    begin
        ted := nil;
        NextPing( ted );
        while ted <> nil do begin
            if ted^.dead & (ted^.result <> inProgress) then begin
                MDisposePtr( ted^.results.data );
                DequePing( ted );
                MDisposePtr(ted );
                leave; { just do one - if we do more, we have to fix the following call to NextPing }
            end;
            if have_OT then begin
                if TickCount > ted^.timeout then begin
                    ted^.result := icmpEchoTimeoutErr;
{                    KillOTPing( ted );
                    leave;}
                end;
            end;
            NextPing( ted );
        end;
    end;

    procedure ReadPingResponse;
        var
            err: OSStatus;
            src: InetAddress;
            udata: TUnitData;
            flags: OTFlags;
            pmp: PingMessagePtr;
            ping_len: longint;
            ted: TransportSendPingDataPtr;
            remotehost: ipAddr;
            data_len: longint;
            finish_time: UnsignedWide;
    begin
        if rawip <> nil then begin
            udata.addr.buf := @src;
            udata.addr.maxlen := SizeOf(src);
            udata.opt.buf := nil;
            udata.opt.maxlen := 0;
            udata.udata.buf := idle_space;
            udata.udata.maxlen := idle_space_size;
            err := OTLFRcvUData( rawip, udata, flags );
            if err = noErr then begin
                if IsPingResponse( udata.udata.buf, udata.udata.len, remotehost, pmp, ping_len ) then begin
                    if FindPing( pmp^.id, pmp^.sequence, ted ) & (ted^.result = inProgress) then begin
                        data_len := Min( ping_len - SizeOf(PingMessage), ted^.results.datasize );
                        ted^.results.remotehost := remotehost;
                        Microseconds( finish_time );
                        ted^.results.timetaken := finish_time.lo - ted^.start_time.lo;
                        ted^.results.datasize := data_len;
                        ted^.result := noErr;
                        BlockMoveData( AddPtrLong( pmp, Sizeof(PingMessage) ), ted^.results.data, data_len );
                    end;
                end;
            end else if err <> kOTNoDataErr then begin
                ClosePing( err );
            end;
        end;
    end;

    procedure ICMPCompletion (cbp: IPControlBlockPtr; irp:PingRecordPtr);
        var
            ted: TransportSendPingDataPtr;
    begin
        ted := TransportSendPingDataPtr(irp);
        ted^.result := cbp^.ioResult;
        ted^.results.datasize := Min( cbp^.echoinfo.data.size - 8, ted^.results.datasize ); { hack?  -8 to correct MacTCP weirdness???? }
        BlockMoveData( cbp^.echoinfo.data.buffer, ted^.results.data, ted^.results.datasize );
        ted^.results.timetaken := (cbp^.echoinfo.echoReplyIn - cbp^.echoinfo.echoRequestOut) * 16667; { ticks -> microseconds }
    end;

    function TransportIPSendPing (remotehost: ipAddr; timeout: integer; datap: Ptr; datalen: integer; var token: Ptr): OSStatus;
        var
            err: OSStatus;
            ted: TransportSendPingDataPtr;
    begin
        ted := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr( ted, SizeOf(TransportSendPingData) );
            if err = noErr then begin
                ted^.result := inProgress;
                ted^.results.remotehost := remotehost;
                ted^.timeout := TickCount + timeout*second_in_ticks;
                ted^.dead := false;
                ted^.results.datasize := datalen + 1000;
                err := MNewPtr( ted^.results.data, ted^.results.datasize );
                if err = noErr then begin
                    if have_OT then begin
                        err := OpenPing;
                        if err = noErr then begin
                            ted^.id := ping_id;
                            ted^.sequence := ping_sequence;
                            ping_sequence := band(ping_sequence + 1, $7FFF);
                            err := OTSendPing( remotehost, ted^.id, ted^.sequence, datap, datalen );
                            if err = noErr then begin
                                Microseconds( ted^.start_time );
                            end;
                        end;
                    end else begin
                        err := MTIPSendPing( remotehost, timeout, datap, datalen, ICMPCompletion, pointer(ted) );
                    end;
                end;
                if err <> noErr then begin
                    MDisposePtr( ted^.results.data );
                    MDisposePtr( ted );
                end else begin
                    EnquePing( ted );
                end;
            end;
            token := Ptr(ted);
        end;
        TransportIPSendPing := err;
    end;

    procedure TransportGetIPSendPingResult( var token: Ptr; var result: OSStatus; var results: TransportPingResults );
        var
            ted: TransportSendPingDataPtr;
    begin
        if have_OT then begin
            ReadPingResponse;
        end;
        KillDeadPings;
        ted := TransportSendPingDataPtr(token);
        if ValidPing( ted ) then begin
            result := ted^.result;
            if result <> inProgress then begin
                DequePing( ted );
                results := ted^.results;
                if result <> noErr then begin
                    MDisposePtr( results.data );
                end;
                MDisposePtr( token );
            end;
        end else begin
            result := -900021;
        end;
    end;

    procedure TransportDisposeIPSendPingResult( var results: TransportPingResults );
    begin
        MDisposePtr( results.data );
    end;

    procedure TransportAbortIPSendPing( var token: Ptr );
        var
            ted: TransportSendPingDataPtr;
    begin
        ted := TransportSendPingDataPtr(token);
        Assert( ted <> nil );
        if have_OT then begin
            if  TransportSystemIsAlive = noErr then begin
                KillOTPing( ted );
            end;
        end else begin
            ted^.dead := true;
        end;
        token := nil;
    end;

    procedure IdleTransports;
        var
            this, next:TransportRecordPtr;
    begin
        this := TransportRecordPtr(transports.qHead);
        while this <> nil do begin
            next := this^.next;
            ProcessOpen(this);
            if this^.open_result = noErr then begin
                IdleSend(this);
                IdleReceive(this);
            end;
            if not have_OT then begin
                IdleMacTCPConnectionState(this);
            end;
            this := next;
        end;
    end;

    procedure IdleTransport;
    begin
        IdleDNRs;
        IdleTransports;
        ReadPingResponse;
        CheckClosePing;
    end;

    function HasOTLib:boolean;
    begin
{$IFC GENERATINGPOWERPC}
        HasOTLib := longint(@OTInstallNotifier) <> kUnresolvedCFragSymbolAddress;
{$ELSEC}
        HasOTLib := true;
{$ENDC}
    end;

    function HasOT: boolean;
        var
            gv: longint;
    begin
        HasOT := HasOTLib & (Gestalt(gestaltOpenTpt, gv) = noErr) &
            btst(gv, gestaltOpenTptPresentBit) & btst(gv, gestaltOpenTptTCPPresentBit);
    end;

    procedure ConfigureTransport(allow_OT: Boolean);
    begin
        DidStartup( startup_check );
        StartupTransport;
        if not allow_OT then begin
            have_OT := false;
        end else begin
            have_OT := HasOT;
        end;
    end;

    function InitTransport(var msg: integer):OSStatus;
        var
            err: OSErr;
    begin
{$unused(msg)}
        AssertDidStartup( startup_check );
{        transition_notifier_count := 0; } { initialized to zero by default, InstallNotifer may be called before Startup() }
        hack_MemoryReleasedProc := nil;
        gMyDeferredTaskHandlerProc := NewProc(@MyDeferredTaskHandler, uppDeferredTaskProcInfo);
        tcp_open_status := -900022;
        transport_system_is_alive := false;
        last_reopen_time := TickCount - max_reopen_frequency - 10;
        dnrs.qHead := nil;
        dnrs.qTail := nil;
        transports.qHead := nil;
        transports.qTail := nil;
        is_ref := nil;
        is_result := -900025;
        err := MNewPtr( idle_space, idle_space_size );
        if err = noErr then begin
            InitPing;
        end;
        InstallTransitionNotifier( DNRNotifier, true );
        ot_version := 0;
        if have_OT then begin
            AddOSErr( err, Gestalt( gestaltOpenTptVersions, ot_version ) );
            InstallTransitionNotifier( PingNotifier, true );
            InstallTransitionNotifier( InternetServicesNotifier, true );
        end;
        InitTransport := err;
    end;

    procedure FinishTransport;
    begin
        CloseTransportSystem;
    end;

    procedure StartupTransport;
    begin
        StartupTCPUtils;
        SetStartup(InitTransport, IdleTransport, 0, FinishTransport);
    end;

end.